perm filename FORCE.COO[1,VDS]1 blob sn#279284 filedate 1977-04-22 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00040 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00005 00002	∂19-Apr-77  0943	BES  	FORCE WRIST   
C00007 00003	   VALID 00009 PAGES   WRIST.SAI
C00008 00004	BEGIN "WRIST"
C00011 00005	STRING PROCEDURE GETTIM
C00013 00006	⊃ MATRIX SOLVERS:  DECOMPOSE, SOLVE
C00020 00007	⊃ MISC ROUTINES:  SOLVER, TYPEFORCE
C00022 00008	⊃ MATRIX INVERSION ROUTINES: INVERT, PINVERSE
C00025 00009	⊃ START OF MAIN PROGRAM, INITIALIZE KEY VARIABLES
C00029 00010	⊃ ASK WHAT WE ARE TO DO WITH THE DATA
C00033 00011	⊃ SAVE DATA ON DISK FILE
C00037 00012	   VALID 00004 PAGES    TLKEF6.FAI
C00038 00013	TITLE TLKEF6
C00040 00014	START OF EXECUTABLE CODE
C00044 00015		[LOCAL STORAGE AREA]
C00046 00016	   VALID 00017 PAGES        IO.PAL
C00048 00017	IO - TELETYPE IO AND STRING MANIPULATION ROUTINES
C00050 00018	"INSTR" - VT05 INPUT ROUTINE 
C00053 00019	"HOLD" - VT05 ROUTINE TO TEMPORARILY SUSPEND PRINTING
C00054 00020	"RELSCN"- STRING TO FLOATING POINT NUMBER ROUTINE
C00057 00021		   [CONTINUATION OF "RELSCN"]
C00060 00022		   [CONTINUATION OF "RELSCN"]
C00063 00023	"INTSCN"- STRING TO INTEGER NUMBER ROUTINE
C00065 00024	"CLRCMA"- ROUTINE TO CLEAR COMMA BREAK CHARACTER FROM STRING 
C00066 00025	"FORMAT"&"RSTFOR" - ROUTINES TO SET AND RESTORE OUTPUT FORMAT 
C00068 00026	"CVF"   - FLOATING POINT NUMBER TO "F" FORMAT STRING ROUTINE 
C00071 00027	"CVE"   - FLOATING POINT NUMBER TO "E" FORMAT STRING ROUTINE 
C00074 00028	 	   [CONTINUATION OF "CVE"]
C00076 00029	"CVG"   - FLOATING POINT NUMBER TO "E" OR "F" FORMAT STRING  
C00078 00030	"PRTF"  - PRINTING ROUTINE USED BY "CVF", "CVE", & "CVG"
C00081 00031	"CVI"&"CVO"   - INTEGER NUMBER TO ASC STRING 
C00084 00032	LOCAL STORAGE AREA
C00088 00033	   VALID 00008 PAGES       INTFAC.PAL
C00089 00034	.TITLE INTFAC
C00091 00035	DAC TEST SECTION
C00093 00036	ADC TEST SECTION
C00095 00037	CONT. OF ADC ROUTINE
C00096 00038	SUBRS AND CLOCK INTERRUPT ROUTINE
C00099 00039	SECTION TO READ FORCE WRIST AND RETURN INFORMATION TO PDP10
C00101 00040	LOCAL STORAGE
C00103 ENDMK
C⊗;
∂19-Apr-77  0943	BES  	FORCE WRIST   
THE PROGRAMS NECESSARY TO CALIBRATE THE FORCE WRIST ARE WRIST.SAI[UP,BES],
TLKEF6.PAL[11,BES], IO.PAL[3,BES], AND INTFAC.PAL[3,BES].  I DON'T KNOW
WHAT KIND OF SHAPE THE PROGRAMS ARE IN SINCE I HAVEN'T LOOKED AT THEM FOR
QUITE A WHILE BUT I SUSPECT THEY DONT REPRESENT SOME OF MY BETTER WORK
SINCE I THREW THEM TOGETHER TO TEST OUT MY CALIBRATION PROCEDURE.  THERE
IS PROBABLY A LOT THAT COULD AND SHOULD BE CHANGED IN EACH OF THESE
PROGRAMS SO THE CONVERSION TASK SHOULD BE A GOOD PROJECT FOR SOMEONE TO
WORK ON.  HOWEVER, I THINK THAT YOU SHOULD MAIL A LISTING OF EACH OF THESE
PROGRAMS TOGETHER WITH A COPY OF THE SECTION IN OUR LAST PROGRESS REPORT
WHERE THE CALIBRATION PROCEDURE WAS DESCRIBED IN ADDITION TO SENDING THE
CODE OVER THE NET.  THIS IS BECAUSE SOME OF THE CHARACTERS IN THE PROGRAMS
MAY NOT BE DIRECTLY TRANSLATABLE(SP ?) INTO WHATEVER CHARACTER SET COOK IS
USING.  ALSO, BEFORE DOING ANY TRANSFERING OVER THE NET, PLEASE COPY ALL
OF THESE PROGRAMS INTO ONE OF YOUR AREAS.
BRUCE
COMMENT ⊗   VALID 00009 PAGES   WRIST.SAI
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "WRIST"
C00005 00003	STRING PROCEDURE GETTIM
C00007 00004	⊃ MATRIX SOLVERS:  DECOMPOSE, SOLVE
C00014 00005	⊃ MISC ROUTINES:  SOLVER, TYPEFORCE
C00016 00006	⊃ MATRIX INVERSION ROUTINES: INVERT, PINVERSE
C00019 00007	⊃ START OF MAIN PROGRAM, INITIALIZE KEY VARIABLES
C00023 00008	⊃ ASK WHAT WE ARE TO DO WITH THE DATA
C00027 00009	⊃ SAVE DATA ON DISK FILE
C00031 ENDMK
C⊗;
BEGIN "WRIST"

COMMENT - THIS PROGRAM IS USED TO CALIBRATE THE SCHEINMAN FORCE SENSING
	  WRIST.;

DEFINE ⊃="COMMENT",CR="'15",LF="'12",CRLF="('15&'12)",FF="'14";
DEFINE NSAMPS=10;

INTEGER I,J,K,DSET;
INTEGER DUM,CHAN,CCHAN,FLAG,ERR;
BOOLEAN TERSE,ASKAGAIN;
BOOLEAN ISCAL,DONTSTOP;
STRING COM1;
STRING ANS,MES,LINED;
STRING STOPIT,OUTBUF,OUTBUF2,OUTBUF3;
REAL DX,DY,DZ;

SAFE INTEGER ARRAY PS[1:50];
INTEGER ARRAY READINGS[1:NSAMPS,1:8];
INTEGER ARRAY IBASE[1:8];
REAL ARRAY AVER[1:8],CAVER[1:8],BASE[1:8],SD[1:8];

PRELOAD_WITH 	1.0, 0.0, 0.0, 0.0, 0.0, 0.0,
                0.0, 1.0, 0.0, 0.0, 0.0, 0.0,
                0.0, 0.0, 1.0, 0.0, 0.0, 0.0,
                0.0, 0.0, 0.0, 1.0, 0.0, 0.0,
                0.0, 0.0, 0.0, 0.0, 1.0, 0.0,
                0.0, 0.0, 0.0, 0.0, 0.0, 1.0;
REAL ARRAY MPRIME[1:6,1:6];
	
PRELOAD_WITH
       10.0, 0.0, 0.0,  0.0, -7.5,  0.0,
	0.0,10.0, 0.0,  7.5,  0.0,  0.0,
       10.0, 0.0, 0.0,  0.0,-71.5,  0.0,
	0.0, 5.0, 0.0,35.75,  0.0,  0.0,
	0.0, 0.0, 4.4,  0.0,  0.0,  0.0,
	0.0,10.0, 0.0,  7.5,  0.0,-40.0;
OWN REAL ARRAY F[1:6,1:6];

PRELOAD_WITH
-124.0, -7.0,   -1.8,   53.0,   115.6,  -12.5,  -8.0,   -65.20,
20.0,   82.0,   134.7,  -9.0,   14.0,   -83.0,  -111.0, 1.00,
-115.0, 8.00,   8.00,   791.0,  119.0,  -21.0,  -43.0,  -789.20,
25.0,   409.0,  58.0,   -19.1,  23.0,   -398.5, -64.0,  15.1,
3.00,   39.10, 0.00,   35.00,   -3.20,  45.00,  2.30,   47.00,
-265.0, 83.0,  -138.90, 13.0,  -255.20, -73.00, -396.00,  -12.00;
OWN REAL ARRAY EPS[1:6,1:8];

REAL ARRAY M[1:6,1:8],MI[1:8,1:6];


EXTERNAL INTEGER PROCEDURE TLKEF6(INTEGER ARRAY READINGS);
REQUIRE "TLKEF6.REL" LOAD_MODULE;
STRING PROCEDURE GETTIM;

⊃ DETERMINES THE CURRENT DAY AND TIME, CONVERTS THEM TO ASC STRING
CONSTANTS AND RETURNS THE COMPOSITE STRING.;

	BEGIN "GETTIM"
	INTEGER DAY,HOUR,T,WID,DIG,YEAR,MON;
	PRELOAD_WITH "JAN","FEB","MAR","APR","MAY","JUNE","JULY",
		     "AUG","SEPT","OCT","NOV","DEC";
	OWN STRING ARRAY MONTHS[1:12];
	STRING TIME;

	⊃ GET THE CURRENT TIME;

	GETFORMAT(WID,DIG);
	SETFORMAT(-2,0);
	TIME←"CURRENT TIME AND DATE: ";
	QUICK_CODE
		'47540400101;
		HLRZ	'14,'13;
		HRRZ	'13,'13;
		MOVEM	'13,HOUR;
		MOVEM	'14,DAY;
	END;

	⊃ COMPUTE AND CONVERT THE TIME OF DAY;

	T←HOUR/60;
	HOUR←T/60;
	T←T-HOUR*60;
	TIME←TIME&CVS(HOUR)&":"&CVS(T)&"  ";

	⊃ COMPUTE AND CONVERT THE DAY OF THE YEAR;

	MON←DAY/31;
	DAY←(DAY MOD 31)+1;
	YEAR←(MON/12)+64;
	MON←(MON MOD 12)+1;
	TIME←TIME&CVS(DAY)&MONTHS[MON]&CVS(YEAR)&CRLF;

	SETFORMAT(WID,DIG);
	RETURN(TIME);
	END "GETTIM";
⊃ MATRIX SOLVERS:  DECOMPOSE, SOLVE;

PROCEDURE DECOMPOSE(INTEGER N;SAFE REAL ARRAY A,LU);

⊃ Both A and LU are [1:N, 1:N].  Uses global array PS.  Computes
triangular matrices L and U and permutation matrix PS so that LU=PA.
Stores (L-I) and U both in LU.  The call DECOMPOSE(N,A,A) will
overwrite A with LU. ;
 
	BEGIN "decompose"
	INTEGER I, J, K, PIVOTINDEX;
	REAL NORMROW, PIVOT, SIZE, BIGGEST, MULT;
	SAFE OWN REAL ARRAY R[1:50];

        SIMPLE PROCEDURE ILOOP(INTEGER UL;REFERENCE REAL R1,R2);
	    ⊃  Machine-coded for efficiency;
            START_CODE
	    LABEL LP,EU;
                    MOVE 1,-1('17);
                    MOVE 2,-2('17);
                    MOVE 3,-3('17);
                    SUB 3,K;
                    JUMPLE 3,EU;
            LP:     AOJ 1,;
                    AOJ 2,;
                    MOVN 4,MULT;
                    FMPR 4,(1);
                    FADRM 4,(2);
                    SOJG 3,LP;
            EU:     END;

	IF N > 50
	THEN USERERR(0,1,"DECOMPOSE can't handle a matrix as large as" & CVS(N));

	⊃  Initialize PS,LU and R;
        FOR I←1 STEP 1 UNTIL N DO
            BEGIN
            PS[I]←I;
            NORMROW←0;
            FOR J←1 STEP 1 UNTIL N DO
                BEGIN
                LU[I,J]←A[I,J];
                IF (NORMROW<ABS(LU[I,J])) THEN NORMROW←ABS(LU[I,J]);
                END;
	    IF (NORMROW≠0)
	    THEN R[I]←1/NORMROW
	    ELSE BEGIN
		R[I]←0; 
		USERERR(0,1,"Zero row in DECOMPOSE");
		END;
	    END;

	⊃ Gaussian elimination with partial pivoting;
	FOR K←1 STEP 1 UNTIL N-1 DO
	    BEGIN "kloop";
            BIGGEST ← 0;
            FOR I ← K STEP 1 UNTIL N DO
                BEGIN
                SIZE←ABS(LU[PS[I],K])*R[PS[I]];
                IF (BIGGEST<SIZE)
		THEN BEGIN
		    BIGGEST←SIZE;
		    PIVOTINDEX←I;
		    END;
                END;
            IF BIGGEST = 0
	    THEN BEGIN 
                USERERR(0,1,"Singular matrix in DECOMPOSE");
                DONE "kloop";
		END;
	    IF PIVOTINDEX ≠ K
	    THEN BEGIN
                J←PS[K];
		PS[K]←PS[PIVOTINDEX];
		PS[PIVOTINDEX]←J;
                END;
            PIVOT←LU[PS[K],K];
            FOR I←K+1 STEP 1 UNTIL N DO
		BEGIN
                LU[PS[I],K]←MULT←(LU[PS[I],K]/PIVOT);
                IF MULT ≠ 0
		THEN ILOOP(N,LU[PS[I],K],LU[PS[K],K]);
                    ⊃ The following is the result of the machine code:
                        FOR J ← K+1 STEP 1 UNTIL N DO
                            LU[PS[I],J]←LU[PS[I],J]-MULT*LU[PS[K],J];
                END;
	    END "kloop";
        IF (LU[PS[N],N]=0)
	THEN USERERR(0,1,"Singular matrix in DECOMPOSE");
        END "decompose";



SIMPLE PROCEDURE SOLVE(INTEGER N;SAFE REAL ARRAY LU,B,X);

⊃ Arrays LU[1:N,1:N], B[1:N], X[1:N].  Uses global safe integer array
PS.  Solves AX=B using LU from DECOMPOSE.  ;

        BEGIN "solve"
        INTEGER I,J;
        REAL DOT;

        SIMPLE PROCEDURE ILOOP(INTEGER LL,UL;REFERENCE REAL R1,R2);
	    ⊃ Machine-coded for efficiency;
            START_CODE
	    LABEL LP,EU;
                    MOVE 1,-1('17);
                    MOVE 2,-2('17);
                    MOVE 3,-3('17);
                    SUB 3,-4('17);
                    SETZ 4,;
                    JUMPL 3,EU;
            LP:     MOVE 5,(1);
                    FMPR 5,(2);
                    FADR 4,5;
                    AOJ 1,;
                    AOJ 2,;
                    SOJGE 3,LP;
            EU:     MOVEM 4,DOT;
            END;

        FOR I ← 1 STEP 1 UNTIL N DO
            BEGIN
	    ILOOP(1,I-1,LU[PS[I],1],X[1]);
	    ⊃ Has this effect:
		DOT←0 
	        FOR J←1 STEP 1 UNTIL I-1 DO
                    DOT←DOT+LU[PS[I],J]*X[J];
            X[I]←B[PS[I]]-DOT;
            END;

        X[N] ← X[N] / LU[PS[N],N];
        FOR I ← N-1 STEP -1 UNTIL 1 DO
            BEGIN  ⊃ RF: I changed loop upper index from N, to avoid 
		subscript errors;
            ILOOP(I+1,N,LU[PS[I],I+1],X[I+1]);
	    ⊃  Has this effect:
		DOT←0
		FOR J←I+1 STEP 1 UNTIL N DO
		    DOT←DOT+LU[PS[I],J]*X[J];
            X[I]←(X[I]-DOT)/LU[PS[I],I];
            END;
	END "solve";
⊃ MISC ROUTINES:  SOLVER, TYPEFORCE;

PROCEDURE SOLVER(REAL ARRAY MI,EPS,F);

	BEGIN "SOLVER"
	INTEGER I,J,K;
	REAL ARRAY LU[1:6,1:6],E[1:6],M[1:6];

	⊃ TRIANGULARIZE THE FORCE MATRIX;

	DECOMPOSE(6,F,LU);

	⊃ COPY THE SIX READINGS FOR EACH GAGE AND SOLVE FOR A 
	  ROW OF THE INVERSE CALIBRATION MATRIX.  REPEAT FOR
	  ALL EIGHT STRAIN GAGE PAIRS.;

	FOR I ← 1 STEP 1 UNTIL 8 DO 
		BEGIN "SOLOOP"
		FOR J ← 1 STEP 1 UNTIL 6 DO E[J]←EPS[J,I];
		SOLVE(6,LU,E,M);
		FOR J ← 1 STEP 1 UNTIL 6 DO MI[I,J]←M[J];
		END "SOLOOP";

	END "SOLVER";


PROCEDURE TYPEFORCE(REAL ARRAY F);
	
	BEGIN "TYPEFORCE"
	REAL MAG;
	OUTSTR(CRLF&"THE RESULTING FORCE VECTOR IS ("&CVF(F[1])&
		","&CVF(F[2])&","&CVF(F[3])&")"&CRLF&
	       "THE RESULTING MOMENT VECTOR IS("&CVF(F[4])&
		","&CVF(F[5])&","&CVF(F[6])&")"&CRLF);
	MAG← ( F[1]↑2 + F[2]↑2 + F[3]↑2 )↑0.5;
	OUTSTR("THE MAGNITUDE OF THE FORCE IS "&CVF(MAG)&CRLF);
	END "TYPEFORCE";
⊃ MATRIX INVERSION ROUTINES: INVERT, PINVERSE;


PROCEDURE INVERT (INTEGER N; REAL ARRAY A );

⊃ COMPUTES THE INVERSE OF THE NxN MATRIX "A" AND RETURNS THE INVERTED
MATRIX IN "A".  THE PROCEDURES "SOLVE" AND "DECOMPOSE" ARE USED TO
COMPUTE THE INDIVIDUAL ROWS OF THE INVERSE MATRIX.;
 
	BEGIN "INVERT"
	INTEGER I,J;
	REAL ARRAY LU[1:N,1:N],IDENT[1:N],X[1:N];

	⊃ COPY THE ARRAY AND TRIANGULARIZE IT;

	ARRTRAN(LU,A);
	DECOMPOSE(N,LU,LU);
	
	⊃ COMPUTE THE ROWS OF THE INVERSE ONE BY ONE;

	FOR I ← 2 STEP 1 UNTIL N DO IDENT[I]←0.0;
	FOR I ← 1 STEP 1 UNTIL N DO
		BEGIN "INVLOOP"
		IDENT[I]←1.0;
		SOLVE(N,LU,IDENT,X);
		FOR J ← 1 STEP 1 UNTIL N DO A[J,I]←X[J];
		IDENT[I]←0.0;
		END "INVLOOP";
	END "INVERT";



PROCEDURE PINVERSE(REAL ARRAY M,MI);

⊃ COMPUTES THE PSUEDO INVERSE OF A NON-SQUARE 6x8 MATRIX, MI, AND 
RETURNS THE INVERTED 8x6 MATRIX IN M.  THE EQUATION IMPLEMENTED BY
THIS ROUTINE IS	AS FOLLOWS:

		        T      -1    T
		M ← ( MI * MI )  * MI

WHERE THE "*" DENOTES MATRIX MULTIPLICATION;

	BEGIN "PINVERSE"
	REAL ARRAY A[1:6,1:6];
	REAL STOTAL;
	INTEGER I,J,K;

	⊃ COMPUTE THE PRODUCT OF MI AND ITS TRANSPOSE;

	FOR I ← 1 STEP 1 UNTIL 6 DO 
	   FOR J ← 1 STEP 1 UNTIL 6 DO
		BEGIN "PMULT"
		STOTAL←0.0;
		FOR K ← 1 STEP 1 UNTIL 8 DO
			STOTAL←STOTAL+MI[K,I]*MI[K,J];
		A[I,J]←STOTAL;
		END "PMULT";

	⊃ INVERT THE PRODUCT AND MULTIPLY BY THE TRANSPOSE AGAIN;

	INVERT(6,A);
	FOR I ← 1 STEP 1 UNTIL 6 DO
	   FOR J ← 1 STEP 1 UNTIL 8 DO
		BEGIN "FMULT"
		STOTAL←0.0;
		FOR K ←1 STEP 1 UNTIL 6 DO
			STOTAL←STOTAL+A[I,K]*MI[J,K];
		M[I,J]←STOTAL;
		END "FMULT";

	END "PINVERSE";
⊃ START OF MAIN PROGRAM, INITIALIZE KEY VARIABLES;

OUTSTR(CRLF&CRLF&"*** FORCE BALANCE RESOLUTION PROGRAM ***"&CRLF);
DX← DY← DZ ← 0.0;
TERSE←TRUE;
LINED←""; COM1←"";

⊃ READ IN THE CALIBRATION TABLE IF IT EXISTS, AND TYPE AN APPROPRIATE
  MESSAGE.;

CCHAN←1;
OPEN(CCHAN,"DSK",0,2,0,DUM,DUM,DUM);
LOOKUP(CCHAN,"FORCAL.CAL",FLAG);
IF FLAG=0 THEN BEGIN
	FOR I ← 1 STEP 1 UNTIL 6 DO
	   FOR J ←1 STEP 1 UNTIL 8 DO M[I,J]←REALIN(CCHAN);
	OUTSTR("CALIBRATION TABLE READ FROM DISK"&CRLF);
	ISCAL←TRUE;
   END ELSE BEGIN
	OUTSTR("NO CALIBRATION DATA FOUND ON DISK"&CRLF);
	ISCAL←FALSE;
	END;
RELEASE(CCHAN);

⊃ MAIN LOOP, CHECK FOR TERMINATION OR WAIT TO TAKE READING;

DONTSTOP←TRUE;
WHILE DONTSTOP DO
	BEGIN "MAIN"
	ERR←1;
	WHILE ERR≠0 DO
		BEGIN
	       	OUTSTR(CRLF&"Type CR to read strain gages: ");
		INCHWL;
	        ERR←TLKEF6(READINGS);
		END;

⊃ COMPUTE STATISTICS FOR READINGS.;


	FOR I←1 STEP 1 UNTIL 8 DO 
		BEGIN
		AVER[I]←0.0;
		SD[I]←0.0;
		END;
	FOR I←1 STEP 1 UNTIL NSAMPS DO 
	   FOR J←1 STEP 1 UNTIL 8 DO 
		BEGIN
		AVER[J]←AVER[J]+READINGS[I,J];
		SD[J]←SD[J]+READINGS[I,J]↑2;
		END;
	FOR I←1 STEP 1 UNTIL 8 DO 
		BEGIN
		AVER[I]←AVER[I]/NSAMPS;
		CAVER[I]←AVER[I]-BASE[I];
		SD[I]←((SD[I]-NSAMPS*AVER[I]↑2)/(NSAMPS-1))↑0.5;
		END;

⊃ PRINT THE DATA.  SAVE OUTPUT STRING FOR LATER.;

	SETFORMAT(9,2);
	OUTBUF←GETTIM&
               "Strain Gage Readings: Mean, Corrected Mean, Standard Dev."&
		CRLF;
	OUTBUF2←OUTBUF3←"";
	FOR I ← 1 STEP 1 UNTIL 8 DO
		BEGIN
		OUTBUF←OUTBUF&CVF(AVER[I]);
		OUTBUF2←OUTBUF2&CVF(CAVER[I]);
		OUTBUF3←OUTBUF3&CVF(SD[I]);
		END;
	OUTBUF←OUTBUF&CRLF&OUTBUF2&CRLF&OUTBUF3&CRLF&CRLF;
	OUTSTR(OUTBUF);
	IF ¬TERSE THEN 
		BEGIN
		OUTBUF2←"Raw Data:"&CRLF;
		FOR I ←1 STEP 1 UNTIL NSAMPS DO
			BEGIN
		   	FOR J ← 1 STEP 1 UNTIL 8 DO 
				OUTBUF2←OUTBUF2&CVS(READINGS[I,J])&"  ";
			OUTBUF2←OUTBUF2&CRLF;
			END;
		OUTSTR(OUTBUF2&CRLF);
		END;
⊃ ASK WHAT WE ARE TO DO WITH THE DATA;

	ASKAGAIN←TRUE;
	WHILE ASKAGAIN DO
		BEGIN "DATALOOP"
		OUTSTR("What do you want to do? (A,B,C,D,G,R,S,T,X,CR,?)= ");
		LODED(LINED&CR);
		LINED ← INCHWL;
		IF EQU(LINED,"?") THEN 
			OUTSTR( "  A - Print all data collected"&CRLF&
				"  B - Set new data base offset"&CRLF&
			        "  C - Use data for calibration"&CRLF&
				"  D - Halt execution of WRIST"&CRLF&
				"  G - Go read strain gages again"&CRLF&
				"  R - Resolve forces and moments"&CRLF&
				"  S - Save data set on disk"&CRLF&
				"  T - Terse output"&CRLF&
				"  X - Resolve at external location"&CRLF&
				"  ? - Print this message"&CRLF)
		ELSE IF EQU(LINED,"G") THEN ASKAGAIN←FALSE
		ELSE IF EQU(LINED,"D") THEN ASKAGAIN←DONTSTOP←FALSE

⊃ SET OUTPUT TERSE/FULL MODE;

		ELSE IF EQU(LINED,"A") THEN TERSE←FALSE
		ELSE IF EQU(LINED,"T") THEN TERSE←TRUE

⊃ USER WANTS TO SET NEW DATA OFFSET;

		ELSE IF EQU(LINED,"B") THEN 
			BEGIN
			FOR I←1 STEP 1 UNTIL 8 DO 
				BEGIN
				BASE[I]←AVER[I];
				IBASE[I]←READINGS[1,I];
				END;
			OUTSTR("New data base offset set"&CRLF);
			ASKAGAIN←FALSE;
			END

⊃ RESOLVE FORCES AND MOMENTS AT AN EXTERNAL LOCATION;

		ELSE IF EQU(LINED,"X") THEN
			BEGIN
			OUTSTR("Type Dx,Dy,Dz = ");
			ANS ← INCHWL;
			DX ← REALSCAN(ANS,DUM);
			DY ← REALSCAN(ANS,DUM);
			DZ ← REALSCAN(ANS,DUM);
			MPRIME[4,2]←-DZ;
			MPRIME[4,3]←DY;
			MPRIME[5,1]←DZ;
			MPRIME[5,3]←-DX;
			MPRIME[6,1]←-DY;
			MPRIME[6,2]←DX;
			END

⊃ FORCE AND MOMENT COMPUTATION;

		ELSE IF EQU(LINED,"R") THEN
		    IF ¬ISCAL THEN 
			OUTSTR("NO CALIBRATION DATA"&CRLF)
		    ELSE BEGIN "RESOLVE"
			REAL ARRAY F[1:6],FPRIME[1:6];
			SETFORMAT(8,2);
			FOR I←1 STEP 1 UNTIL 6 DO 
				BEGIN
				F[I]←0.0;
				FOR J←1 STEP 1 UNTIL 8 DO 
				   F[I]←F[I]+M[I,J]*(READINGS[1,J]-IBASE[J]);
				END;
			TYPEFORCE(F);
			FOR I←1 STEP 1 UNTIL 6 DO
				BEGIN
				FPRIME[I]←0.0;
				FOR J←1 STEP 1 UNTIL 6 DO
				   FPRIME[I]←FPRIME[I]+MPRIME[I,J]*F[J];
				END;
			OUTSTR(CRLF&"FORCE/MOMENTS RECOMPUTED AT ("&CVF(DX)&
				","&CVF(DY)&","&CVF(DZ)&")"&CRLF);
			TYPEFORCE(FPRIME);
			ASKAGAIN←FALSE;
			END "RESOLVE"
⊃ SAVE DATA ON DISK FILE;

		ELSE IF EQU(LINED,"S") THEN
			BEGIN "SAVEIT"
			INTEGER CHAN;
			OUTSTR("OUTPUT COMMENT =");
			LODED(COM1&CR);
 			COM1←INCHWL;
			CHAN←3;
			OPEN(CHAN,"DSK",0,2,2,DUM,DUM,DUM);
			LOOKUP(CHAN,"FORCAL.DAT",DUM);
			ENTER(CHAN,"FORCAL.DAT",DUM);
			QUICK_CODE
				UGETF	3,DUM;
			END;
			OUT(CHAN,COM1&CRLF&OUTBUF&CRLF&FF);
			RELEASE(CHAN);
			END "SAVEIT"

⊃ USE DATA FOR FORCE CALIBRATION, PRINT CURRENT DATA;

		ELSE IF EQU(LINED,"C") THEN
			BEGIN "CALIB"
			OUTSTR("CURRENT CALIBRATION DATA:"&CRLF&
			  " TEST #         FORCES AND MOMENTS"&CRLF);
			SETFORMAT(8,3);
			FOR I ← 1 STEP 1 UNTIL 6 DO 
				BEGIN
				ANS←CVS(I)&"  ";
				FOR J ← 1 STEP 1 UNTIL 6 DO
					ANS←ANS&CVF(F[I,J]);
				OUTSTR(ANS&CRLF);
				END;

⊃ REPLACE OLD DATA WITH NEW;

			OUTSTR("REPLACE DATA SET (0=NONE) = ");
			ANS ← INCHWL;
			DSET←INTSCAN(ANS,DUM);
			IF DSET≠0 THEN
				BEGIN
				ANS←"";
				FOR I ← 1 STEP 1 UNTIL 6 DO
					ANS←ANS&CVF(F[DSET,I]);
				OUTSTR("NEW FORCES/MOMENTS =");
				LODED(ANS&CR);
				ANS ←INCHWL;
				FOR I ← 1 STEP 1 UNTIL 6 DO 
					F[DSET,I]←REALSCAN(ANS,DUM);
				FOR I ← 1 STEP 1 UNTIL 8 DO 
					EPS[DSET,I]←CAVER[I];
				END;
			
⊃ ASK IF THE CALIBRATION MATRIX IS TO BE COMPUTED;
			
			OUTSTR("COMPUTE NEW CALIBRATION MATRIX (Y,N)? ");
			ANS←INCHWL;
			IF EQU(ANS,"Y") THEN
				BEGIN
				SOLVER(MI,EPS,F);
				PINVERSE(M,MI);
				ISCAL←TRUE;
				END;

⊃ SAVE NEW CALIBRATION ON THE DISK?;

			OUTSTR("SAVE NEW MATRIX ON THE DISK (Y,N)? ");
			ANS←INCHWL;
			IF EQU(ANS,"Y") THEN
				BEGIN
				CHAN←3;
				OPEN(CHAN,"DSK",0,0,2,120,DUM,DUM);
				ENTER(CHAN,"FORCAL.CAL",DUM);
				SETFORMAT(15,7);
				FOR I←1 STEP 1 UNTIL 6 DO 
				   FOR J ← 1 STEP 4 UNTIL 5 DO
					BEGIN "PLINE"
					MES←"";
					FOR K ← J STEP 1 UNTIL J+3 DO 	
 						MES←MES&CVE(M[I,K])&"  ";
					OUT(CHAN,MES&CRLF);
					END "PLINE";
				OUT(CHAN,CRLF&CRLF&"CALIBRATION MATRIX: "&GETTIM);
				RELEASE(CHAN);
				END;
			END "CALIB";
		END "DATALOOP";
	END "MAIN";

⊃ EXIT CLEANLY;

OUTSTR("I SURE HOPE THE #@!## IS CALIBRATED!!!!"&CRLF);

END "WRIST"
COMMENT ⊗   VALID 00004 PAGES    TLKEF6.FAI
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE TLKEF6
C00004 00003	START OF EXECUTABLE CODE
C00008 00004		[LOCAL STORAGE AREA]
C00011 ENDMK
C⊗;
TITLE TLKEF6
INTERNAL TLKEF6

;"TLKEF6" IS A SAIL CALLABLE PROCEDURE FOR READING THE FORCE SENSING WRIST
;STRAIN GAGES FROM A PROGRAM THAT RUNS ON THE PDP11/45.  A SAMPLE
;SAIL CALL IS AS FOLLOWS:
;
;	ERROR←TLKEF6(INTEGER ARRAY READINGS);  
;WHERE
;	ERROR = 0 IF "TLKEF6" WAS SUCCESSFUL, ≠0 OTHERWISE
;	READINGS = 10x8 ARRAY IN WHICH THE STRAIN GAGES READINGS ARE RETURNED
;
;THIS ROUTINE TYPES IT'S OWN ERROR MESSAGES ON THE TTY.

;DEFINITIONS

P←17		;PUSH STACK REGISTER
MASLOC←40000	;MASTER NUMBER IN ELF
DATADD←40001	;START ADDRESS TO READ DATA FROM ELF
MASTER←10567	;CHECK NUMBER FROM ELF IF DONE READING
DBUFL ←=80	;NUMBER OF WORDS TO TRANSFER FROM THE ELF
;START OF EXECUTABLE CODE

TLKEF6:	SETZ	1,		;CLEAR ERROR FLAG
       	MOVEM	16,HOLD+16	;SAVE THE REGISTERS
	HRRZI	16,HOLD
	BLT	16,HOLD+15

;INTIALIZE THE ELF AND CLEAR THE MASTER NUMBER.  THIS INSURES THAT
;WE READ CURRENT DATA

	IOPUSH	1,		;CALLER MIGHT WANT THIS CHANNEL
	JRST	[   OUTSTR CM0	;IOPDLOV MESSAGE
		    JRST   ERR  ]
	INIT	1,17  		;INITIALIZE THE ELF
	SIXBIT	/ELF/
	0
	JRST	[   OUTSTR CM1		;ERROR RETURN
ERR:		    AOS    HOLD+1	;RETURN ERROR VALUE
		    JRST   TLKDNE  ]
	GETSTS	1,1		;GET THE ELF STATUS WORD
	TRNE	1,777700	;CHECK FOR ERROR CONDITION
	JRST	[   OUTSTR CM2		;INDICATE STATUS ERROR
		    JRST   ERR    ]
	MTAPE	1,MASADR	;ZERO MASTER NUMBER
	JRST	[   OUTSTR CM3   	;ERROR RETURN
		    JRST   ERR  ]

;WAIT TILL ELF COLLECTS THE DATA
	
	MOVEI	3,=10		;TRY READING ELF DATA 10 TIMES
READLP:	SETZ	1,		;SLEEP BEFORE TRYING AGAIN
	SLEEP	1,
	MTAPE	1,DNEADD	;GET THE DONE WORD FROM THE ELF
	JRST	[   OUTSTR CM6		;ERROR RETURN
		    JRST   ERR  ]
	MOVE	2,DNEWRD	;LOAD VALUE INTO REGISTER
	JUMPG 	2,ELFDNE	;BRANCH IF THE ELF SIGNALS DONE
	SOJG	3,READLP	;REPEAT IF MORE TIME LEFT
	OUTSTR	CM4 		;ELSE TELL OPERATOR ELF TOOK TOO MUCH TIME
	JRST	ERR

;TRANSFER THE DATA BACK TO THE MAIN PROGRAM IF ALL WENT WELL
	
ELFDNE:	CAIE	2,MASTER	;MAKE SURE WE GOT THE RIGHT MASTER NUMBER
	JRST	[   OUTSTR CM7	;SIGNAL ERROR
	            JRST   ERR	]
	MOVE	2,-1(P)		;GET ADDRESS TO TRANSFER DATA
	SOJ	2,     		;DECREMENT ARRAY POINTER
	HRLI	2,-DBUFL 	;SET POINTER TO TRANSFER DATA
	MOVEM	2,INLST
     	USETI	1,GAGE  	;SET UP INPUT STRAIN GAGE DATA
     	IN	1,INLST		;READ IN A BLOCK OF DATA
	JRST	.+2		;NORMAL RETURN
	JRST	[   OUTSTR CM8		;ERROR RETURN
		    JRST   ERR  ]

;RETURN TO CALLING PROGRAM

TLKDNE:	IOPOP	1,		;RELEASE THE ELF & RESTORE CHANNEL 1
	JFCL			;JUST CANNOT HAPPEN
       	HRLZI	16,HOLD		;RESTORE THE REGISTERS
	BLT	16,16
	SUB	P,[2(2)]	;POP ARGUMENTS OFF STACK
	JRST	@2(P)		;RETURN
;	[LOCAL STORAGE AREA]

HOLD:	BLOCK	17

;I/O DATA AREAS

GAGE:	400004,,400000+DATADD	;MODE AND ADDRESS FOR "IN" OF STRAIN GAGE DATA

INLST:	0			;PT. TO DATA ARRAY
	0

MASADR:	003000,,MASLOC		;CLEAR MASTER WORD
	0

DNEADD:	002004,,MASLOC		;MODE AND ADDRESS FOR MASTER DONE WORD
DNEWRD:	0			;VALUE OF DONE WORK

;OUTPUT STRINGS

CM0:	ASCIZ/IOPDLOV WHEN TRY TO SAVE CHANNEL 1 FOR "ELF"
/

CM1:	ASCIZ/CANNOT INIT "ELF"
/
CM2:	ASCIZ/"ELF" STATUS WORD INDICATES ERROR CONDITION
/
CM3:	ASCIZ/UNABLE TO ZERO MASTER NUMBER IN "ELF"
/
CM4:	ASCIZ/"ELF" NOT TRANSFERING STRAIN GAGE READINGS
/
CM5: 	ASCIZ/BAD READ FROM "ELF" DURING POSITION DATA TRANSFER
/
CM6:	ASCIZ/ELF READ ERROR WHILE WAITING FOR ADC READING TO COMPLETE
/
CM7:	ASCIZ/ELF MASTER NUMBER INCORRECT, CAN'T READ THE DATA
/
CM8:	ASCIZ/ERROR IN TRANSFERING STRAIN GAGE DATA
/

END         
COMMENT ⊗   VALID 00017 PAGES        IO.PAL
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	IO - TELETYPE IO AND STRING MANIPULATION ROUTINES
C00006 00003	"INSTR" - VT05 INPUT ROUTINE 
C00009 00004	"HOLD" - VT05 ROUTINE TO TEMPORARILY SUSPEND PRINTING
C00010 00005	"RELSCN"- STRING TO FLOATING POINT NUMBER ROUTINE
C00013 00006		   [CONTINUATION OF "RELSCN"]
C00016 00007		   [CONTINUATION OF "RELSCN"]
C00019 00008	"INTSCN"- STRING TO INTEGER NUMBER ROUTINE
C00021 00009	"CLRCMA"- ROUTINE TO CLEAR COMMA BREAK CHARACTER FROM STRING 
C00022 00010	"FORMAT"&"RSTFOR" - ROUTINES TO SET AND RESTORE OUTPUT FORMAT 
C00024 00011	"CVF"   - FLOATING POINT NUMBER TO "F" FORMAT STRING ROUTINE 
C00027 00012	"CVE"   - FLOATING POINT NUMBER TO "E" FORMAT STRING ROUTINE 
C00030 00013	 	   [CONTINUATION OF "CVE"]
C00032 00014	"CVG"   - FLOATING POINT NUMBER TO "E" OR "F" FORMAT STRING  
C00034 00015	"PRTF"  - PRINTING ROUTINE USED BY "CVF", "CVE", & "CVG"
C00037 00016	"CVI"&"CVO"   - INTEGER NUMBER TO ASC STRING 
C00040 00017	LOCAL STORAGE AREA
C00044 ENDMK
C⊗;
;IO - TELETYPE IO AND STRING MANIPULATION ROUTINES

.TITLE  IO 

;***NOTE: ALL OF THE REGISTER DEFINITIONS REQUIRED BY THESE ROUTINES****
;***	CAN BE FETCHED BY DOING A ".INSRT HALHED[HAL,HE]"	********


;"CRLF" IS A SUBROUTINE FOR TYPING OUT ONE CARRIAGE RETURN AND LINE FEED 
;ON THE TELETYPE.

CRLF:	MOV	#CRLFX,SG	
	JSR	PC,TYPSTR
	RTS	PC

CRLFX:  .BYTE	15,12,0,0

;"TYPSTR" OUTPUTS A STRING, ENDING WITH A ZERO CHARACTER.  A POINTER TO
;THE START OF THE STRING MUST BE LOADED INTO R5.  CALLED USING THE PC.

TYPSTR:	MOV 	R0,-(SP)	
	BR	2$
1$:	JSR	PC,TYPCHR	;TYPE THIS CHARACTER
2$:	MOVB	(SG)+,R0	;GET A CHARACTER
	BNE	1$		;END OF LINE?
	MOV	(SP)+,R0
	RTS 	PC		;Done

TYPCHR:	TST 	OUTSW		;VT05 or console?
	BEQ 	TYPCH1	
	TSTB 	KBOS		;VT05: Is it available?
	BPL	TYPCHR		;No
	MOVB 	R0,KBOR		;Output a byte to it.
	CMP 	#12,R0		;Was it a line feed?
	BNE 	TYPRET		;If not that code, then done.
	CLR 	R0		;Otherwise, output 3 nulls.
	JSR 	PC,TYPCHR	;
	JSR 	PC,TYPCHR	;
	BR	TYPCHR		;Direct jump; it will return to caller.
TYPCH1:	TSTB 	OREG		;Console:  Ready?
	BNE 	TYPCHR		;No.
	MOVB 	R0,OREG		;Yes.  Output a byte to it.
	MOV	#1,172566	;Wake up pdp10 by generating interrupt
TYPRET:	RTS 	PC		;Return.
;"INSTR" - VT05 INPUT ROUTINE 

;STRING BYTE POINTER MUST BE  IN SG.  A CARRIAGE RETURN  IS ASSUMED TO
;BE  THE  ACTIVATION CHARACTER.  A  RUB OUT  IS  A  DELETING BACKSPACE
;CHARACTER.  AT  THE COMPLETION OF  THIS ROUTINE  A NULL CHARACTER  IS
;PLACED IN THE INPUT STRING.  SG IS LEFT UNCHANGED.

;REGISTERS USED:
;
; 	SG PASSES ARGUMENT AND IS NOT MODIFIED

INSTR:	MOV	R0,-(SP)
	MOV	SG,-(SP)
IN2:	TST 	OUTSW		;VT05 OR CONSOLE?
	BEQ 	CONSIN	
	TSTB	KBIS		;TEST IF KEYBOARD READY
	BEQ	IN2		;WAIT TILL IT IS
	MOVB	KBIR,R0		;GET A CHARACTER
	BR	GOTCAR
CONSIN:	MOV	IREG,R0		;BYTE FROM PDP10?
	BEQ	IN2		;NO
	CLR	IREG
GOTCAR:	BIC     #177600,R0	;MASK OFF - MAKE IT 7 BITS
	CMP	R0,#177		;COMPARE TO BS CHARACTER
	BNE	IN3		;SKIP IF ITS NOT
	CMP	SG,(SP)		;CHECK IF ANY CHARACTERS IN BUFFER
	BEQ	IN2		;FORGET BACK SPACE IF NO CHAR.
	DEC     SG   		;REMOVE LAST CHARACTER IN BUFFER
	MOV	SG,-(SP)
	MOV	#DBS,SG		;PERFORM A DELETING BACKSPACE
	JSR	PC,TYPSTR
	MOV	(SP)+,SG
	BR      IN2
IN3:	CMP	R0,#15		;COMPARE TO CR CHARACTER
	BEQ     IN4   		;CONTINUE READING IF ITS NOT A CR
	CMP	R0,#40		;CHECK IF CHARACTER LEGAL
	BLT	IN2		;IGNOR IF IT IS
    	MOVB	R0,(SG)+	;SAVE THE CHARACTER
	JSR	PC,TYPCHR	;ECHO CHARACTER
	BR 	IN2		;CONTINUE READING
IN4:	MOVB	R0,(SG)+	;END OF STRING,PUT IN A CR 
	CLRB	(SG)		;PUT IN A NULL CHARACTER
      	JSR	PC,CRLF		;TYPE CR/LF
	MOV	(SP)+,SG
	MOV	(SP)+,R0
	RTS	PC		;RETURN

DBS:	.BYTE	10,40,10,0
;"HOLD" - VT05 ROUTINE TO TEMPORARILY SUSPEND PRINTING

;IF A CHARACTER HAS BEEN TYPED ON THE VT05 KEYBOARD, THIS ROUTINE GOES
;INTO A BUSY WAIT LOOP UNTIL ANOTHER CHARACTER IS TYPED.  BOTH CHARACTERS
;ARE LOST.  IF NO CHARACTER HAS BEEN TYPED, THIS ROUTINE RETURNS 
;IMMEDIATELY.

;REGISTERS USED:
;
;	NONE

HOLD:	TSTB	KBIS		;TEST IF CHARACTER TYPED
	BEQ	HLDDNE		;RETURN IF NO CHARACTER
	CLRB	KBIR
	TSTB	KBIS		;ELSE WAIT TILL ANOTHER CHARACTER TYPED
	BEQ	.-4
	CLRB	KBIR
HLDDNE:	RTS	PC



;END OF "HOLD"
;"RELSCN"- STRING TO FLOATING POINT NUMBER ROUTINE

;THE FLOATING POINT NUMBER MUST BE OF THE FORM SIII.DDDESXX WHERE S IS
;THE SIGN OF THE NUMBER, III IS THE INTEGER FIELD,  DDD IS THE DECIMAL
;FIELD,  AND SXX  IS THE EXPONENT  AND ITS SIGN.   THE LENGTH OF  EACH
;FIELD IS VARIABLE  BUT ONLY THE FIRST 8 DIGITS  ARE USED IN COMPUTING
;THE F.P.   NUMBER.  EMPTY FIELDS ARE PERMITTED AND ALL LEADING SPACES
;AND ZEROS ARE IGNORED.  THE LOCATION OF THE FIRST  BYTE OF THE STRING
;MUST  BE LOADED INTO  SG BEFORE  CALLING "RELSCN".   AFTER EXECUTION,
;THIS ROUTINE LEAVES THE F.P. NUMBER IN REGISTER AC0 AND SG POINTS  TO
;THE BYTE FOLLOWING THE LAST DIGIT.  THE C BIT IS USED TO INDICATE AN 
;ERROR CONDITION.  IF NO NUMBER WAS FOUND BEFORE ENCOUNTERING A COMMA
;OR NULL CHARACTER, THE C BIT IS SET OTHERWISE THE C BIT IS CLEARED ON
;EXITING THIS ROUTINE.  "RELSCN" IS CALLED USING THE PC.

;REGISTERS USED:
;
;	AC0,SG PASS ARGUMENTS, NO OTHER REGISTERS AFFECTED


;"DIGIT" CHECKS FOR ASC DIGIT AND CONVERTS TO INTEGER IF IT IS

.MACRO DIGIT NOTDIG
	CMP	R0,#60		;COMPARE TO ASC ZERO
	BLT	NOTDIG		;SKIP IF OUT OF RANGE
	CMP	R0,#71		;COMPARE TO ASC 9
	BGT	NOTDIG		;SKIP IF OUT OF RANGE
	BIC	#60,R0		;MASK OUT ASC BASE
.ENDM

;"CKSIGN" CHECKS FOR A - OR + CHARACTER AND SETS SIGN APPROPRIATELY

.MACRO CKSIGN ISSIGN,NTSIGN,SIGN
	CMP	#53,R0		;IGNOR "+" CHARACTER
	BEQ	ISSIGN
	CMP	#55,R0		;CHECK IF ITS A "-" CHAR.
	BNE	NTSIGN		;EXIT IF ITS NOT
	INC	SIGN		;ELSE SET SIGN NON-ZERO
	BR 	ISSIGN
.ENDM

;START OF "RELSCN"

RELSCN:	MOV	R0,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)
	MOV	R2,-(SP)
      	MOV	R3,-(SP)	
      	CLR	R2 		;RESET DIGIT COUNT
	MOV	#1,R3		;SET DECIMAL POINT FLAG
	   [CONTINUATION OF "RELSCN"]

	MOV	#-1,R1		;INDICATE NO DIGITS ENCOUNTERED
 	CLRF	AC0		;CLEAR THE NUMBER ACCUM
	CLR	MSIGN		;ASSUME MANTISSA POSITIVE

;PICK UP A CHARACTER AND CHECK FOR SIGN

PICK:	MOVB	(SG)+,R0	;PICK UP A CHARACTER
	TST	R1		;CHECK IF DIGIT ENCOUNTERED
	BEQ	CHKDG		;SKIP IF TRUE
	CKSIGN	PICK,CHKDG,MSIGN	;CHECK FOR + OR - SIGN

;CHECK IF CHARARCTER IS A DIGIT

CHKDG:	DIGIT	CHKDP		;SKIP TO CHKDP IF NOT A DIGIT
	MULF	TEN,AC0		;MULT DIGIT SUM BY 10
	ASH	#2,R0		;MULTIPLY INDEX BY 4
	ADDF	DGLST(R0),AC0	;ADD THE F.P. TO ACCUM
	CLR     R1    		;INDICATE DIGIT ENCOUNTERED
	SUB     #4,R2		;DECREMENT DIGIT COUNT
	JMP	PICK		;GO GET ANOTHER CHARACTER

;CHECK IF THE CHARACTER IS A DECIMAL POINT

CHKDP:	CMP	#56,R0		;COMPARE CHARACTER TO DECIMAL PT
	BNE	RNORM		;SKIP IF NOT D.P.
      	TST	R3		;CHECK IF DECIMAL POINT ALREADY SET
	BEQ	RNORM		;IF RESET THIS MUST BE A THE END OF THE MANT.
	CLR	R2		;START COUNTING FRACTIONAL DIGITS
	CLR	R3		;INDICATE D.P. SET
	CLR	R1		;INDICATE DIGIT ENCOUNTERED
	JMP	PICK		;GO GET ANOTHER CHARACTER

;CORRECT NUMBER FOR POWER OF TEN IF DIGITS FOUND

RNORM:	TST	R1		;CHECK IF DIGITS FOUND
	BNE	CHKEX		;SKIP IF NONE
	TST	R3		;CHECK IF DECIMAL POINT SET
	BNE	CHKEX		;DONT NORMALIZE IF NO D.P.
    	MULF	TENLST(R2),AC0	;CORRECT DECIMAL POINT

;CHECK IF E SIGN ENCOUNTERED

CHKEX:	CMP	#105,R0		;COMPARE TO E CHARACTER
	BNE	CHKDN		;SKIP IF NOT E
	TST	R1   		;CHECK IF NO DIGITS BEFORE E
	BEQ	EXCN
	LDF	TENLST,AC0	;SET AC0=1 IF EXPONENT BUT NO DIGITS
	   [CONTINUATION OF "RELSCN"]

	CLR	R1		;INDICATE DIGITS ENCOUNTERED
EXCN:	CLR	ESIGN		;ASSUME EXPONENT POSITIVE
	CLR	R3		;CLEAR EXPONENT ACCUMULATOR
	MOVB	(SG)+,R0	;GET NEXT CHARACTER
	CKSIGN	PIC2,DIG2,ESIGN	;CHECK FOR SIGN CHARACTER
PIC2:	MOVB	(SG)+,R0	;SIGN INCOUNTERED, GET NEXT CHAR.
DIG2:	DIGIT	NORM		;EXTRACT DIGIT 
	MUL	#10.,R3		;MULT EXPON REG BY 10.
	ADD	R0,R3		;ADD DIGIT TO EXPONENT REG
	JMP	PIC2		;GO GET ANOTHER CHARACTER

NORM:	TST	ESIGN		;CHECK SIGN OF EXPONENT
	BEQ	.+4
	NEG	R3		;COMPLEMENT EXPONENT IF - SIGN
	ASH	#2,R3		;MULT. INDEX BY 4 FOR F.P. NUMBERS
	MULF	TENLST(R3),AC0	;ADJUST EXPONENT OF NUMBER
	JMP	CDONE		;EXIT ROUTINE

;CHECK IF END OF STRING OR COMMA ENCOUNTERED

CHKDN:	TST     R0		;COMPARE CHARACTER TO A NULL CHARACTER
	BEQ	CDONE		;EXIT IF IT IS, THIS IS THE END OF THE STR
	CMP	#54,R0		;COMPARE TO ","
	BEQ	CDONE		;EXIT IF IT IS
	TST	R1		;TEST IF ANY DIGITS YET
	BLT	PICK		;IF NONE, KEEP SCANNING

;NO MORE DIGITS - APPLY CORRECT SIGN TO NUMBER

CDONE:	DEC	SG		;POINT TO BREAK CHARACTER
    	TST	MSIGN		;TEST SIGN OF MANTISSA
	BEQ	.+4
	NEGF	AC0		;COMPLEMENT NUMBER IF SIGN NEGATIVE
       	TST	R1		;TEST IF NO NUMBER ENCOUNTERED
	BEQ	.+4
	SEC			;SET C REGISTER IF NO NUMBER FOUND
       	MOV	(SP)+,R3	;RESTORE REGISTERS
	MOV	(SP)+,R2
     	MOV	(SP)+,R1
     	MOV	(SP)+,R0
	RTS	PC		;RETURN


;END OF "RELSCN"
;"INTSCN"- STRING TO INTEGER NUMBER ROUTINE

;THE INTEGER NUMBER MUST BE OF THE FORM SIII WHERE S IS THE SIGN OF THE
;NUMBER, AND III IS THE INTEGER FIELD.  ALL LEADING SPACES AND  ZEROS
;ARE IGNORED.  THE LOCATION OF THE FIRST BYTE OF THE STRING MUST BE 
;LOADED INTO REGISTER SG BEFORE CALLING "INTSCN".  AFTER EXECUTION,
;THIS ROUTINE LEAVES THE INTEGER NUMBER IN R0 AND SG POINTS TO
;THE BYTE FOLLOWING THE LAST DIGIT.  THE C BIT IS USED TO INDICATE AN 
;ERROR CONDITION.  IF NO NUMBER WAS FOUND BEFORE ENCOUNTERING A COMMA
;OR NULL CHARACTER, THE C BIT IS SET.  ALSO, IF THE INTEGER NUMBER IS
;TOO LARGE, THE C BIT IS SET, OTHERWISE THE C BIT IS CLEARED ON EXITING
;THIS ROUTINE.  "INTSCN" IS CALLED USING THE PC.

;REGISTERS USED:
;
;	R0,SG PASS ARGUMENTS AND ARE ALTERED
;	AC0 IS GARBAGED

INTSCN:	JSR	PC,RELSCN	;CONVERT STRING NUMBER TO FLOATING POINT
	BCC	.+4
	RTS	PC		;EXIT IF NO NUMBER FOUND
	STCFI	AC0,R0		;ELSE CONVERT NUMBER TO INTEGER
	CFCC			;TRANSFER CODITIONAL CODES
	RTS	PC		;RETURN


;END OF "INTSCN"
;"CLRCMA"- ROUTINE TO CLEAR COMMA BREAK CHARACTER FROM STRING 

;"CLRCMA" CAN BE CALLED FOLLOWING "RELSCN" TO ADJUST THE STRING
;POINTER IN SG TO SKIP OVER THE COMMA CHARACTER WHICH IS USED
;TO SEPARATE NUMBERS IN THE SAME INPUT STRING.  SG MUST BE 
;POINTING AT THE INPUT STRING.  NO OTHER REGISTERS ARE EFFECTED.

CLRCMA:	TSTB	(SG)		;CHECK IF AT END OF STRING
	BNE	.+4	
	RTS	PC		;RETURN IF END OF STRING
	CMPB	#54,(SG)+	;COMPARE TO COMMA CHARACTER
	BNE	CLRCMA		;BRANCH IF IT ISN'T
	RTS	PC		


;END OF "CLRCMA"
;"FORMAT"&"RSTFOR" - ROUTINES TO SET AND RESTORE OUTPUT FORMAT 

;THE TOTAL NUMBER OF CHARACTERS TO BE WRITTEN (WIDTH) SHOULD BE
;LOADED INTO R0 AND THE NUMBER OF DECIMAL DIGITS (DIGITS) SHOULD
;BE LOADED INTO R1 BEFORE CALLING THIS ROUTINE.  IN ALL CASES,
;WIDTH SHOULD BE GREATER THAN OR EQUAL TO DIGIT+2.  "FORMAT" IS
;CALLED BY USING THE PC.

;REGISTERS USED:
;
;	R0,R1 PASS ARGUMENTS
;	NO OTHER REGISTERS AFFECTED

FORMAT:	MOV	WIDTH,OLDW	;SAVE THE OLD WIDTH
	MOV	DIG,OLDD	;   AND DIG
	SUB	#2,R0		;SUBTRACT SPACES FOR SIGN AND . FROM WIDTH
	MOV	R0,WIDTH	;SAVE WIDTH OF I/O STRING - 2
	MOV	R1,DIG		;SAVE THE NUMBER OF DECI. DIGITS
	CMP	R0,R1		;CHECK TO SEE THAT WIDTH.GE.DIGIT+2
	BGE	NFER		;SKIP IF SPACE ALLOWED, ELSE CORRECT
	MOV	SG,-(SP)	;TYPE OUT ERROR MESSAGE
	MOV	#FERM,SG
	JSR	PC,TYPSTR
	MOV	(SP)+,SG
	MOV	R1,WIDTH	;SET WIDTH=DIG+2
NFER:	RTS	PC		;RETURN

FERM:	.ASCIZ /
FORMATTING ERROR
/
	.EVEN


;"RSTFOR" - ROUTINE TO RESTORE LAST FORMAT

;THE PREVIOUS FORMAT BECOMES THE CURRENT FORMAT.  THE CURRENT
;FORMAT IS LOST FOREVER.  "RSTFOR" IS CALLED IN USING THE PC.

;REGISTERS USED:  NONE

RSTFOR:	MOV	OLDW,WIDTH	;RESTORE WIDTH
	MOV	OLDD,DIG	;RESTORE DIG
	RTS	PC		;RETURN


;END OF "FORMAT" &"RSTFOR"
;"CVF"   - FLOATING POINT NUMBER TO "F" FORMAT STRING ROUTINE 

;"CVF" - THE STRING GENERATED BY THIS ROUTINE IS SIMILAR TO "F" FORMAT
;IN  FORTRAN.  IT  IS ASSUMED  THAT THE NUMBER  TO BE CONVERTED  IS IN
;REGISTER AC0  AND SG  CONTAINS A  POINTER TO  THE FIRST  BYTE OF  THE
;OUTPUT STRING.  THE NUMBER OF  CHARACTERS WRITTEN SHOULD FIRST BE SET
;IN  A CALL  TO "FORMAT", ELSE  THE DEFAULT VALUES  ARE USED.   IF THE
;INTEGER PART  OF  THE  NUMBER EXCEEDS  THE  FORMAT LIMITS  THE  FIRST
;CHARACTER WRITTEN  IS A ">".   AFTER COMPLETION, "CVF"  LEAVES A NULL
;CHARACTER FOLLOWING THE NUMBER STRING.  REGISTER SG IS LEFT  POINTING
;AT THE NULL CHARACTER.

;REGISTERS USED:
;
;	SG,AC0 PASS ARGUMENTS AND ARE ALTERED
;	AC1 IS GARBAGED

CVF:	MOV	R1,-(SP)	;SAVE REGISTER
    	MOV	WIDTH,R1	;GET THE TOTAL NUMBER OF CHAR TO BE WRITTEN
	SUB	DIG,R1		;DETERMINE THE MAG. OF THE M.S. DIGIT
	MOV	R1,PT		;NOW HAVE # OF DIGITS BEFORE DECIMAL POINT
	ASH	#2,R1		;X 4, USE AS INDEX INTO F.P. TABLE
	DIVF	TENLST(R1),AC0	;NORMALIZE NUMBER TO BETWEEN 0 AND .99999999
	MOV	WIDTH,R1	;TOTAL # OF DIGITS TO R1
	MOV	R2,-(SP)	;SAVE THE REGISTERS
	MOV	R3,-(SP)
	JSR	PC,PRTF		;TYPE OUT THE DIGITS
	MOVB	#0,(SG)		;PUT A NULL CHARACTER AFTER THE STRING
	MOV	(SP)+,R3	;RESTORE THE REGISTERS
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	RTS	PC		;RETURN



;END OF "CVF"
;"CVE"   - FLOATING POINT NUMBER TO "E" FORMAT STRING ROUTINE 

;"CVE" - SAME OPERATION AS "CVF" EXCEPT THAT OUTPUT IN FORTRAN "E" FORMAT

CVE:	MOV	R1,-(SP)
     	MOV	R2,-(SP)	;SAVE THE REGISTERS
	MOV 	R3,-(SP)
        CLR     EXPON		;RESET EXPONENT COUNT
	MOV	#1,PT		;SET COUNT TO PRINT 1 NUMBER BEFORE DECIMAL PT
	MOV	WIDTH,R1	;SET COUNT FOR TOTAL NUMBER OF DIGITS TO BE SENT
	SUB	#4,R1		;ADJUST FOR EXPONENT
	TSTF	AC0		;CHECK IF NUMBER IS ZERO
	CFCC			;TRANSFER CONDITIONAL CODES TO CPU
	BEQ	EPRT		;START PRINTING IF NUMBER IS 0.0
     	STF	AC0,NUM		;GET THE NUMBER TO BE CONVERTED
	DEC	EXPON		;ADJUST EXPONENT FOR PRINTING 1 INT. DIGIT
	MOV	NUM,R2		;LOAD THE EXPONENT AND MSB OF THE NUMBER
	BIC	#100000,R2	;CONVERT TO ABSOLUTE VALUE
	SUB	#150,R2		;ADJUST EXPONENT DOWN
	BGE	.+4
	CLR	R2		;LEAVE IT POSITIVE
	MUL	#233,R2		;USE EXPONENT AND MSB AS INDEX INTO TEN TABLE
	CMP	R2,#76.		;COMPARE TO 1.0@38
	BLE	.+6
	MOV	#76.,R2		;IF LARGER, REPLACE BY 1.0@38
      	SUB	#38.,R2		;SHIFT INDEX INTO RANGE OF -38 TO +38
	ADD	R2,EXPON	;ADJUST EXPONENT COUNT
	ASH	#2,R2		;MULT INDEX BY 4 FOR FLOATING POINT NUMBERS
	DIVF	TENLST(R2),AC0	;NORMALIZE NUMBER INTO RANGE 0.0 TO 0.9999
	STF	AC0,AC1		;GET ABSOLUTE VALUE OF NUMBER
	ABSF	AC1
	CMPF	TENLST,AC1	;CHECK IF NUMBER LESS THAN 1.0
	CFCC			;TRANSFER CONDITIONAL CODES TO CPU
	BGT	EPRT		;IF ITS BETWEEN 0.0 AND .99999, GO TO PNTF
	DIVF	TEN,AC0		;ELSE MULT. BY 0.1 AND ADJUST EXPONENT
        INC	EXPON
 	   [CONTINUATION OF "CVE"]

EPRT:	JSR	PC,PRTF		;GO PRINT MANTISSA
	MOVB	#105,(SG)+	;PUT A "E" CHAR INTO THE STRING
	MOVB	#53,(SG)+	;ASSUME EXPONENT POSITIVE A OUTPUT A "+"
	MOV	EXPON,R3	;TEST SIGN OF EXPONENT
	BGE	XPRT		;SKIP IF POSITIVE
	MOVB	#55,-1(SG)	;REPLACE "+" WITH "-"
	NEG	R3    		;MAKE EXPONENT POSITIVE
XPRT:	CLR	R2		;CLEAR FOR DIVISION
     	DIV	#10.,R2		;SEPARATES TENS AND UNITS DIGIT
	BIS	#60,R2		;CONVERT TO ASC AND PUT IN I/O BUFFER
	MOVB	R2,(SG)+
	BIS	#60,R3
	MOVB	R3,(SG)+
	MOVB	#0,(SG)		;PUT IN A NULL CHARACTER
	MOV	(SP)+,R3	;RESTORE THE REGISTERS
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	RTS	PC		;RETURN



;END OF "CVE"
;"CVG"   - FLOATING POINT NUMBER TO "E" OR "F" FORMAT STRING  

;"CVG" - DETERMINES IF THE NUMBER IN AC0 CAN BE WRITTEN BY "CVF", IF
;IT CAN, THEN CVF IS CALLED, ELSE THE NUMBER IS PRINTED USING "CVE".

CVG:	MOV	R1,-(SP)
    	LDF	AC0,AC1		;COPY THE  NUMBER
	CFCC			;TRANSFER THE CONDITIONAL CODES TO CPU
	ABSF	AC1		;CONVERT NUMBER TO ABSOLUTE VALUES
	BEQ	RUNF		;IF NUMBER = 0.0, EXECUTE CVF
	MOV	DIG,R1		;GET THE NUMBER OF DECIMAL DIGITS TO BE TYPED
	ASH	#2,R1		;MULT BY 4 TO USE A FLOATING POINT INDEX
	MULF	TENLST(R1),AC1	;CHECK IF NUMBER SMALLER THAN 1.0@-DIG
	CMPF	TENLST,AC1	;COMPARE TO 1.0
	CFCC			;TRANSFER CONDITIONAL CODES TO CPU
	BGT	RUNE		;IF LESS THAN 1.0@-DIG, PRINT USING CVE
	MOV	WIDTH,R1	;GET THE TOTAL NUMBER OF DIGITS TO BE PRINTED
	ASH	#2,R1		;USE THIS AS A F.P. INDEX
	NEG	R1
	MULF	TENLST(R1),AC1	;CHECK IF GREATER THAN WIDTH-DIG LONG
	CMPF	TENLST,AC1	;COMPARE TO 1.0
	CFCC			;TRANSFER CONDITIONAL CODES
	BGE	RUNF		;IF TOO LARGE, USE CVE
RUNE:	JSR	PC,CVE
	MOV	(SP)+,R1
	RTS	PC
RUNF:	JSR	PC,CVF
	MOV	(SP)+,R1
	RTS	PC


;END OF "CVG"
;"PRTF"  - PRINTING ROUTINE USED BY "CVF", "CVE", & "CVG"

PRTF:	TSTF	AC0		;TEST THE SIGN OF THE NUMBER
	MOVB	#40,MSIGN	;ASSUME SIGN POSITIVE
	CFCC			;TRANSFER THE CONDITIONAL CODES TO CPU
	ABSF	AC0		;CLEAR THE SIGN OF THE NUMBER
	BGE	.+10		
  	MOVB	#55,MSIGN	;IF NEGATIVE PUT IN "-" SIGN
	MODF	TEN,AC0		;COMPUTE M.S. INTEGER DIGIT
	CLR	R3		;INDICATE SIGN NOT YET WRITTEN
DIGLP:	TST	PT		;CHECK IF TIME TO PRINT DECIMAL POINT
	BNE	GETDG		;SKIP IF NOT
	TST	R3		;HAVE WE PRINTED SIGN YET?
	BNE	WTDP		;SKIP IF WE HAVE
	MOVB	MSIGN,(SG)+	;ELSE PRINT SIGN BEFORE DECIMAL POINT
	INC	R3		;INDICATE SIGN PRINTED
WTDP:	MOVB	#56,(SG)+	;PRINT DECIMAL POINT
GETDG:	STCFI	AC1,R2 		;SAVE M.S. INTEGER DIGIT
	CFCC			;CHECK FOR NUMBER TOO LARGE TO INTEGERIZE
	BCC	CHKSZ
TOLGE:	ADDF	AC1,AC0		;IF TWO LARGE, PUT IT BACK TOGETHER
	MODF	TENTH,AC0	;SCALE DOWN AND TRY INTEGERIZING AGAIN
	INC	R1		;PRINT OUT ONE MORE DIGIT
	INC	PT		;SHIFT DECIMAL POINT TO PUT IN EXTRA DIGIT
	TST	R3		;CHECK IF SIGN AND D.P. ALREADY WRITTEN
	BEQ	GETDG		;GO CHECK IF IN RANGE IF NOT WRITTEN
	CLR	R3		;CLEAR SIGN AND D.P.
	SUB	#2,SG		;ADJUST BYTE POINTER
	JMP	GETDG		;GO CHECK IF IN RANGE AGAIN
CHKSZ:	TST     R2              ;TEST INTEGER
	BLT	TOLGE		;IF TOO LARGE, GO SCALE AGAIN
	CMP	R2,#9.		;CHECK IF LESS THAN 9
	BGT	TOLGE		;SCALE IF GREATER THAN 9
      	MODF	TEN,AC0		;START COMPUTING NEXT INTEGER DIGIT
	TST	R3		;HAVE WE PRINTED SIGN YET?
	BNE	SETBS		;SKIP IF WE HAVE
	TST	R2		;CHECK IF LEADING ZERO
	BEQ	WTSP		;IF IT IS GO WRITE A SPACE CHARACTER
	MOVB	MSIGN,(SG)+	;FIRST CHARACTER, NOW PRINT SIGN
	INC	R3		;INDICATE SIGN PRINTED
SETBS:	BIS	#60,R2		;SET ASC ZERO BASE
	JMP	WTCH
WTSP:	MOVB	#40,R2		;WRITE A SPACE CHARACTER
WTCH:	MOVB	R2,(SG)+	;PUT CHARACTER IN I/O BUFFER
	DEC	PT		;DECREMENT DECIMAL POINT COUNT
	SOB	R1,DIGLP	;DONE WITH CHARACTERS?
	RTS	PC		;RETURN


;END OF "PRTF"
;"CVI"&"CVO"   - INTEGER NUMBER TO ASC STRING 

;"CVI"&"CVO" CONVERT THE INTEGER LOADED INTO R0 INTO A ASCII STRING 
;AND APPEND THE NUMBER STRING TO THE STRING POINTED TO BY SG.  SG IS
;LEFT POINTING AT A NULL CHARACTER.  A SAMPLE CALLING SEQUENCE
;FOLLOWS:
;
;		MOV	#NUM,R0		;LOAD NUMBER TO BE CONVERTED
;		MOV	#STRG,SG	;POINT TO OUTPUT STRING
;		JSR	PC,CVI
;
;"CVI" DOES A DECIMAL CONVERSION, WHILE "CVO" WORKS IN BASE 8.

;REGISTERS USED:
;
;	R0, SG PASS ARGUMENTS AND ARE ALTERED

CVI:	MOV	R2,-(SP)	;SAVE REGISTER
	MOV	#10.,R2		;DO A DECIMAL CONVERSION
	BR	CVV

CVO:	MOV	R2,-(SP)	;SAVE REGISTER
	MOV	#8.,R2		;DO A OCTAL CONVERSION

CVV:	MOV	R1,-(SP)	;SAVE REGISTER
	TST	R0		;CHECK SIGN OF NUMBER
	BGE	ITISPL		;BRANCH IF POSITIVE
	NEG	R0		;ELSE COMPLEMENT
	MOVB	#55,(SG)+	;PUSH A "-" INTO STRING
ITISPL:	JSR	PC,DIVLP	;GO FORM STRING RECURSIVELY
	CLRB	(SG) 		;POINT TO A NULL CHARACTER AT END OF STG
	MOV	(SP)+,R1	;RESTORE REGISTERS
	MOV	(SP)+,R2
	RTS	PC		;ALL DONE

DIVLP:	MOV	R0,R1		;POSITION NUMBER FOR DIVISION
       	CLR	R0		;CLEAR FOR DIVISION
	DIV	R2,R0		;GET LSD
	ADD	#60,R1		;OR ASC BASE
	MOVB	R1,-(SP)	;SAVE DIGIT
	TST	R0
	BEQ	.+6		;SKIP IF ALL DONE
	JSR	PC,DIVLP	;REPEAT RECURSIVELY
	MOVB	(SP)+,(SG)+	;PUT DIGITS IN STRING
	RTS	PC


;END OF "CVI"
;LOCAL STORAGE AREA

MSIGN:	0		;SIGN OF CURRENT NUMBER
ESIGN:	0		;SIGN OF EXPONENT
EXPON:	0
NUM:	.WORD  0,0
WIDTH:	8. 		;DEFAULT NUMBER OF CHARACTERS IN OUTPUT STRING
DIG:	3		;DEFAULT NUMBER OF DECIMAL DIGITS
OLDW:	8.		;OLD VALUES OF WIDTH AND DIG
OLDD:	3
PT:	0		;NUMBER OF DIGITS BEFORE DECIMAL POINT

;SYSTEM LINE BUFFERS

INBUF:	.BLKW	42.
OUTBUF:	.BLKW	42.

;TABLE OF F.P. DIGITS FROM 0.0 TO 9.0

DGLST:	.WORD        0,     0, 40200,     0, 40400,     0, 40500,     0
	.WORD    40600,     0, 40640,     0, 40700,     0, 40740,     0
	.WORD    41000,     0, 41020,     0

;TABLE OF POWERS OF TEN

	.WORD      531,143735,  1410, 16352,  2252, 22045,  3124,126456
	.WORD	  4004,166075,  4646, 23514,  5517,130437,  6401,147263
	.WORD	  7242, 41140, 10112,151370, 10775,103666, 11636, 72322
	.WORD	 12506, 11006, 13367,113210, 14232,137025, 15101, 66632
	.WORD	 15761,144400, 16627, 16640, 17474,162410, 20354, 17113
	.WORD	 21223,111357, 22070, 73652, 22746,112625, 23620, 16575
	.WORD	 24464, 22334, 25341, 27023, 26214,136314, 27057,165777
	.WORD	 27733,163377, 30611, 70137, 31453,146167, 32326,137625
	.WORD	 33206, 33675, 34047,142654, 34721,133427, 35603, 11157
	.WORD	 36443,153412
TENTH:	.WORD	 37314,146315 
TENLST:	.WORD	 40200,     0 
TEN:	.WORD	 41040,     0
	.WORD	 41710,     0, 42572,     0, 43434, 40000, 44303, 50000
	.WORD	 45164, 22000, 46030,113200, 46676,136040, 47556, 65450
	.WORD	 50425,  1371, 51272, 41667, 52150,152245, 53021,102347
	.WORD	 53665,163041, 54543, 57651, 55416, 15712, 56261,121274
	.WORD	 57136,  5553, 60012,143443, 60655, 74354, 61530,153447
	.WORD	 62407,103170, 63251, 64026, 64123,141034, 65004, 54521
	.WORD	 65645, 67646, 66516,145617, 67401, 37472, 70241,107410
	.WORD	 71111,171312, 71774, 67574, 72635,142656, 73505, 33431
	.WORD	 74366,102337, 75232, 11414, 76100,113717, 76760,136702
	.WORD	 77626, 73231


;END OF "IO" PROGRAM
COMMENT ⊗   VALID 00008 PAGES       INTFAC.PAL
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.TITLE INTFAC
C00004 00003	DAC TEST SECTION
C00007 00004	ADC TEST SECTION
C00009 00005	CONT. OF ADC ROUTINE
C00010 00006	SUBRS AND CLOCK INTERRUPT ROUTINE
C00013 00007	SECTION TO READ FORCE WRIST AND RETURN INFORMATION TO PDP10
C00015 00008	LOCAL STORAGE
C00017 ENDMK
C⊗;
.TITLE INTFAC
.INSRT HALHED.PAL[HAL,HE]

.=1000  

.INSRT IO.PAL[3,BES]

DRATRP	==530  		;DR11 A VECTOR 	
DRBTRP	==534  		;DR11 B VECTOR		
DR11S	=167770 	;DR11 STATUS WORD 
DR11O	=167772		;DR11 OUTPUT REGISTER 
DR11I	=167774 	;DR11 INPUT REGISTER   
PANICB	=200
ENABLE	=400		;INTERFACE ENABLE

;COMMUNICATIONS LINK TO PDP10

MASTER==10567
MASLOC=100000
FDATA=100002

; program initialization

.EVEN
START:	RESET
	MOV #1000,SP	;initialize stack
	CLR PS		;initialize processor status
      	CLR CLKCNT	;clear clock registers- trap restart
	CLR CLKSET
	CLR CLKS
	LDFPS	#0
	MOV	#9,R0		;SET TTY OUTPUT FORMAT
	MOV	#2,R1
	JSR	PC,FORMAT
	MOV	#CLKSER,CLKTRP	;SET CLOCK INTERRUPT ROUTINE
	MOV	#340,CLKTRP+2
 
;ASK IF DAC OR ADC CHECK
 
	MOV	#COM1,SG	;ASK IF ADC OR DAC
	JSR	PC,GETNUM
	TST	R0
	BNE	ISADC
;DAC TEST SECTION
 
DACSEC:	CLR	DR11S		;SET DR11 DAC MODE
	MOV	#COM2,SG	;GET DAC CHANNEL
	JSR	PC,GETNUM
	MOVB	BRK(R0),R1	;GET BRAKE MASK BIT
	BIS	#ENABLE,R1	;ADD ON INTERFACE ENABLE BIT
	MOV	R1,BRKMSK
	MOVB	DNE(R0),R1	;GET DONE BIT MASK
	SWAB	R1
	MOV	R1,DNEMSK
	ASH	#13.,R0
	MOV	R0,R3
	MOV	#COM3,SG	;CHECK IF POSITION OR TORQUE MODE
	JSR	PC,GETNUM
	TST	R0
	BEQ	ISCUR		;BRANCH IF CURRENT MODE
	MOV	#1,STPDNE	;ASSUME DONE MASK TO BE CHECKED
	MOV	#COM11,SG	;ASK IF DONE BIT TO BE CHECKED
	JSR	PC,GETNUM
	TST	R0
	BNE	WILCHK		;SKIP IF DONE BIT TEST REQUESTED
	BR	.+6
ISCUR:	BIS	#10000,R3	;SET CURRENT MODE BIT
	CLR	STPDNE     	;DON'T EVER STOP ON DONE CONDITION
WILCHK:	MOV	R3,DACCHN	;SAVE DAC CHANNEL
	MOV	#COM4,SG	;GET DC DAC VALUE
	JSR	PC,GETNUM
	MOV	R0,DACDC
	MOV	#COM5,SG
	JSR	PC,GETNUM	;GET DAC RAMP VALUE
	MOV	R0,DACCHG
	CLR	COUNT
	CLR	DR11S		;RESET DR11
	CLR	PDAC		;START AT BOTTOM OF RAMP
	CLR	PTIME		;INDICATE FIRST PASS THROUGH
	MOV	#10.,CLKSET	;SET CLOCK TO INTERRUPT EVERY 100USEC
	MOV	#111,CLKS
CLKWT:	TST	DNEMSK		;CHECK IF DONE BIT ON
	BNE	.+6
	JMP	RUG		;EXIT IF ALL DONE
	TSTB	KBIS		;ELSE CHECK IF SOMEONE HIT THE TTY
	BEQ	CLKWT		;LOOP TILL SOMETHING HAPPENS
	CLR	CLKS		;STOP THE DAC ROUTINE
	JMP	RUG
;ADC TEST SECTION
  
ISADC:	MOV	#2,DR11S	;SET DR11 ADC MODE
	MOV	#COM6,SG	;ASK IF TYPE OUT REQUESTED
	JSR	PC,GETNUM
	MOV	R0,TYPADC
	MOV	#COM7,SG	;SINGLE CHANNEL OR INDEX?
	JSR	PC,GETNUM
	BIC	#177776,R0
	MOV	R0,INDX
	BEQ	SNGCHN
	MOV	#TOPCLR,SG
	JSR	PC,TYPSTR
	CLR	ODDEVN
	BR	ADCSTR
SNGCHN:	MOV	#COM8,SG	;GET STARTING CHANNEL
	JSR	PC,GETNUM
	BIC	#177740,R0
	MOV	R0,ADCCHN	;SAVE START CHANNEL
 
;ADC LOOP
 
ADCSTR:	MOV	#2,DR11S	;REQUEST ADC CONVERSION
ADCLP:	MOV	ADCCHN,DR11O	;REQUEST ADC CONVERSION
	MOV	#100.,R1	;WAIT LOOP COUNT
WAITLP:	BIT	#200,DR11S
	BNE	ADCDNE		;BRANCH IF DONE
	DEC	R1
	BGE	WAITLP		;REPEAT IF STILL MORE TIME LEFT
	MOV	#COM9,SG
	JSR	PC,TYPSTR
	JMP	RUG
ADCDNE:	MOV	DR11I,R0	;GET ADC READING
	TST	TYPADC		;CHECK IF TYPE OUT REQUIRED
	BEQ	GETNXT		;SKIP IF NO
	MOV	#IOBUF,SG
;	ADD	#2048.,R0
	JSR	PC,CVI		;CONVERT TO ASCII
	MOVB	#40,(SG)+
	MOVB	#40,(SG)+
	MOVB	#40,(SG)+
	MOVB	#40,(SG)+
	CLRB	(SG)
	MOV	#IOBUF,SG	;TYPE OUT READING
	JSR	PC,TYPSTR
	JSR	PC,CRLF
;CONT. OF ADC ROUTINE

GETNXT:	TST	INDX		;CHECK IF INDEXING OR SINGLE CHANNEL
	BEQ	TSTDNE
	COM	ODDEVN		;CHECK IF DISPLAY IN RIGHT OR LEFT PART OF SCREEN
	BEQ	ADDIDX		;SKIP IF MOVING TO LEFT
	MOV	#RIGHT,SG
	JSR	PC,TYPSTR
ADDIDX:	ADD	INDX,ADCCHN	;POINT TO NEXT CHANNEL
	CMP	MAXCHN,ADCCHN	;CHECK IF WRAP AROUND TIME
	BGE	TSTDNE		;SKIP IF STILL OK
	CLR	ADCCHN		;ELSE START WITH CHANNEL 0 AGAIN
	CLR	ODDEVN
	TST	TYPADC		;CHECK IF TYPE OUT REQUIRED
	BEQ	TSTDNE
	MOV	#TOP,SG
	JSR	PC,TYPSTR
TSTDNE:	TSTB	KBIS		;CHECK IF VT05 HIT
	BEQ	ADCLP
	JMP	RUG
;SUBRS AND CLOCK INTERRUPT ROUTINE
 
GETNUM:	JSR	PC,TYPSTR
	MOV	#IOBUF,SG
	JSR	PC,INSTR
	MOV	#IOBUF,SG
	JSR	PC,INTSCN
	RTS	PC
 

CLKSER:	MOV	DACDC,R0	;GET DAC OUTPUT VALUE
	ADD	PDAC,R0
	MOV	R0,R1
	BGE	.+4		;CHECK IF IN RANGE
	NEG	R1
	CMP	#4000,R1
	BGE	VALOK		;BRANCH IF OK
	MOV	DACDC,R0	;ELSE START OVER AT DC VALUE
	MOV	DACCHG,PDAC
	NEG	PDAC
;
;	MOV	#1,DR11S	;USE THIS TO SYNC ON WHEN TESTING
;	MOV	BRKMSK,DR11O	
;
VALOK:	BIC	#170000,R0
	BIS	DACCHN,R0	;ADD DAC CHANNEL
	CLR	DR11S
	MOV	R0,DR11O
	ADD	DACCHG,PDAC
	TST	PTIME		;CHECK IF NOT FIRST PASS THROUGH
	BNE	CHKDNE		;BRANCH IF NOT PASS ONE
	MOV	#1,DR11S	;ELSE SET BRAKE MODE
	MOV	BRKMSK,DR11O	;TURN OFF BRAKE AND ENABLE INTERFACE
	MOV	#1,PTIME	;INDICATE END OF FIRST PASS
	RTI
CHKDNE:	MOV	#3,DR11S	;GET ARM STATUS BITS     
	MOV	DR11I,R0	
 	BIT	#PANICB,R0	;CHECK IF PANIC BUTTON HIT
 	BEQ	STPIT		;STOP SERVICING IF BUTTON HIT
	TST	STPDNE		;CHECK IF IN RANGE CHECKING TO BE DONE
	BNE	.+4		
	RTI			;RETURN IF NOT CHECKING REQUIRED
	BIT	DNEMSK,R0	;CHECK IF IN RANGE
	BNE	INRNGE
	CLR	COUNT 		;CLEAR IN RANGE COUNT
	RTI			;EXIT IF STILL NOT DONE
INRNGE:	INC	COUNT 		;INCREMENT NUMBER OF SEQUENCE TIMES 
	CMP	#3,COUNT 	;CHECK IF AT LEAST 3 TIMES
	BLE	.+4
	RTI
STPIT: 	CLR	CLKS		;ELSE STOP THE CLOCK
	CLR	DNEMSK
	MOV	#1,DR11S	;SET THE BRAKES
	CLR	DR11O
	RTI
;SECTION TO READ FORCE WRIST AND RETURN INFORMATION TO PDP10

FORCE:
F:	MOV	#MASTER,MASLOC	;INDICATE READY TO READ FORCE WRIST

;WAIT LOOP LOOKING AT COMMAND BLOCK FROM PDP10

WTLP:   TST	KBIS		;CHECK IF ANYONE HIT VT05 KEYBOARD
	BEQ	CHKMST
	CLRB	KBIR
	JMP	RUG		;EXIT TO DDT
CHKMST:	CMP	#MASTER,MASLOC	;CHECK IF NO ONE ALTERED THE M.NUMBER YET
	BEQ	WTLP
	MOV	#FDATA,R1
	MOV	#10.,R2		;READ 10 SETS OF DATA

SETLP:	MOV	#8.,R3		;EIGHT STRAIN GAGES IN ALL
	CLR	R4		;START WITH CHANNEL 0

REDLP: 	MOV	#2,DR11S	;REQUEST ADC CONVERSION
      	MOV	R4,DR11O	
	MOV	#100.,R0	;WAIT LOOP COUNT
WLP:   	BIT	#200,DR11S
	BNE	CNVDNE		;BRANCH IF DONE
	DEC	R0
	BGE	WLP    		;REPEAT IF STILL MORE TIME LEFT
	MOV	#COM9,SG
	JSR	PC,TYPSTR
	JMP	RUG
CNVDNE:	MOV	DR11I,R0	;GET ADC READING
	ADD	#2048.,R0
	MOV	R0,(R1)+	;SAVE READING
	INC	R4		;POINT TO NEXT CHANNEL
	SOB	R3,REDLP	;REPEAT UNTIL DONE
	SOB	R2,SETLP
	BR	F		;REPEAT
;LOCAL STORAGE
 
ODDEVN:	0
DACCHN:	0
DACDC:	0
DACCHG:	0
PDAC:	0
TYPADC:	0
ADCCHN:	0
INDX:	0
MAXCHN:	31.
BRK:	.BYTE	1,2,4,10,20,40,100,0
DNE:	.BYTE	1,2,4,10,20,40,100,0
BRKMSK:	0
DNEMSK:	0
STPDNE:	0
COUNT:	0
PTIME:	0
 
;OUTPUT STRINGS
 
COM1:	.ASCIZ	/DAC OR ADC(0:1) = /
COM2:	.ASCIZ	/DAC NUMBER (0:7) = /
COM3:	.ASCIZ	/CURRENT OR POSITION MODE (0:1) = /
COM11:	.ASCIZ	/CHECK DONE BIT (0=NO,1=YES) = /
COM4:	.ASCIZ	/DAC DC VALUE (-2048 : 2047) = /
COM5:	.ASCIZ	/DAC CHANGE EVERY 100 USEC = /
COM6:	.ASCIZ	/TYPE ADC READINGS (0:1)? = /
COM7:	.ASCIZ	/SINGLE CHANNEL OR INDEX (0:1) = /
COM8:	.ASCIZ	/ADC CHANNEL (0:31) = /
COM9:	.ASCIZ	/**ERROR** NO ADC DONE SIGNALED
/
TOP:	.BYTE	35,10,10,10,0
TOPCLR:	.BYTE	35,35,37,37,37,10,10,10,0
RIGHT:	.BYTE	32,10,10,10,30,30,30,30,30,30,30
	.BYTE	30,30,30,30,0
IOBUF:	.BLKW	100.
PBUF:	.BLKW	300.


.END START